home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / mouse.exe / TMTEST.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1989-06-03  |  4.6 KB  |  145 lines
  1. {program to test a text based Mouse}
  2. program TmTest;
  3. uses crt,Mouse;
  4.  
  5. type string80 = string[80];
  6. var gm,gd,i:integer;
  7.     R,X,Y:integer;
  8.     OmouseX,OmouseY:integer;
  9.     Done:boolean;
  10.     OldClk : word;
  11.     SysClk : word absolute $40:$6C;
  12.     ch : char;
  13.     S : string80;
  14.  
  15. const
  16.    KeyHome = #199;      { defs for simulated cursor movement via keyboard }
  17.    KeyEnd  = #207;
  18.    KeyPgUp = #201;
  19.    KeyPgDo = #209;
  20.    KeyArUp = #200;
  21.    KeyArDo = #208;
  22.    KeyArLft = #203;
  23.    KeyArRgt  = #205;
  24.    KeyL = 'L';
  25.    KeyR = 'R';
  26.    KeyRet = #13;
  27.  
  28.  
  29. { convert an integer to a string }
  30. function fstr(I:integer):string80;
  31. var temp:string80;
  32. begin
  33.   str(i,temp);
  34.   fstr := temp;
  35. end;
  36.  
  37.  
  38. { show the current mouse status info }
  39. procedure ShowPosition;
  40. begin
  41.    HideMouse;
  42.  
  43.    {HideMouseArea is an alternate hide for non-EGA type screens}
  44. {   HideMouseArea(PutMx(1),PutMy(1),PutMx(MaxCrtX),PutMy(MaxCrtY)); }
  45.  
  46.    TextColor(MouseColor);
  47.    S := 'X:'+fstr(GetMx(MouseX))+' Y:'+fstr(GetMy(MouseY))+
  48.        ' CrtMode:'+fstr(CrtMode)+' MouseType:'+fstr(MouseType);
  49.    gotoxy(1,MaxCrtY);
  50.    for i := 1 to length(S)+5 do write(' ');
  51.    gotoxy(1,MaxCrtY);
  52.    Write(s);
  53.    Gotoxy(GetMx(MouseX),GetMy(MouseY));
  54.    ShowMouse;
  55. end;
  56.  
  57.  
  58. {--------------------------------------------}
  59. { begin main program }
  60. begin
  61.    ClrScr;
  62.    TextColor(White);
  63. {   TextMode(3); }         {text mode override}
  64.    for i := 1 to 50 do         { put some random splats on the screen }
  65.    begin                       { to make it look busy }
  66.      X := random(MaxCrtX)+1;
  67.      Y := random(MaxCrtY)+1;
  68.      gotoXY(X,Y);
  69.      write('*');
  70.    end;
  71.  
  72.    MouseColor := white;         { intialize the mouse }
  73.    InitMouse;
  74. {   MouseClock(true);        }  {<-- uncomment this to use mouse ISR }
  75. {   MouseInstalled := false; }  {<-- uncomment this to disable installed mouse}
  76.    MouseTextCursor(0);     { Starting text cursor style }
  77.    SetMouseArea(PutMx(1),PutMy(1),PutMx(MaxCrtX),PutMy(MaxCrtY));
  78.    SetMousePosition(PutMx(MaxCrtX shr 1),PutMy(MaxCrtY shr 1));
  79.    ShowMouse;
  80.  
  81.    Done := false;
  82.    while not(Done) do
  83.    begin
  84.      if KeyPressed then       {we can also move the mouse via the keyboard}
  85.      begin
  86.        ch := upcase(ReadKey);
  87.        if ch = #0 then
  88.          ch := char(ord(ReadKey) or $80);
  89.        case ch of
  90.          KeyHome : begin SetMousePosition(PutMx(1),MouseY); end;
  91.          KeyEnd  : begin SetMousePosition(PutMx(MaxCrtX),MouseY); end;
  92.          KeyPgUp : begin SetMousePosition(MouseX,PutMy(1)); end;
  93.          KeyPgDo : begin SetMousePosition(MouseX,PutMy(MaxCrtY)); end;
  94.          KeyArUp : begin SetMousePosition(MouseX,PutMy(GetMy(MouseY)-1)); end;
  95.          KeyArDo : begin SetMousePosition(MouseX,PutMy(GetMy(MouseY)+1)); end;
  96.          KeyArLft : begin SetMousePosition(PutMx(GetMx(MouseX)-1),MouseY); end;
  97.          KeyArRgt : begin SetMousePosition(PutMx(GetMx(MouseX)+1),MouseY); end;
  98.          KeyL : begin MouseClicked := true; MouseClickButton := 1; end;
  99.          KeyR : begin MouseClicked := true; MouseClickButton := 2; end;
  100.          KeyRet : begin end;
  101.        else
  102.          if ch < #33 then Done := true;
  103.        end;
  104.      end;
  105.  
  106.      { key not pressed, so look at mouse }
  107.      if not(MouseHooked) then ReadMouse;  {if polled mode, poll the mouse}
  108.      if MouseClick then                          {check if button pressed}
  109.      begin
  110.        if MouseClickButton = MouseLeftButton then
  111.        begin
  112.          HideMouse;
  113.          GotoXY(GetMx(MouseX),GetMy(MouseY));   {left button press,}
  114.          TextColor(MouseColor);                 {so put a splat on the}
  115.          write('*');                            {screen in the specified}
  116.          ShowPosition;                          {color at the mouse position}
  117.          ShowMouse;
  118.        end;
  119.        if MouseClickButton = MouseRightButton then
  120.        begin                                       {if right button pressed}
  121.          inc(MouseColor);                               {change mouse shape}
  122.          if MouseColor > White then MouseColor := 1;     {and working color}
  123.          ShowPosition;
  124.          inc(MouseTShape);
  125.          if MouseTShape < 2 then MouseTShape := 2;
  126.          if MouseTShape > MaxMouseTextShape then MouseTShape := 0;
  127.          MouseTextCursor(MouseTShape);
  128.          MouseReDraw := true;
  129.          ShowPosition;
  130.          ShowMouse;
  131.        end;
  132.      end;
  133.  
  134.      { if nothing else is happening, periodically update the mouse status}
  135.      if (OldClk <> SysClk) and
  136.         ((MouseX <> OMouseX) or (MouseY <> OMouseY)) then
  137.      begin
  138.        OMouseX := MouseX;
  139.        OMouseY := MouseY;
  140.        OldClk := SysClk;
  141.        ShowPosition;
  142.      end;
  143.    end;
  144. end.
  145.